home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PAS_0793 / ARCHIVES.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-21  |  4KB  |  108 lines
  1. ─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 301 of 379                                                               
  3. From : MIKE COPELAND                       1:114/151.0          19 Jul 93  14:27 
  4. To   : ALL                                                                       
  5. Subj : ARCHIVES TPU 1/4                                                       
  6. ────────────────────────────────────────────────────────────────────────────────
  7.    In this and the following messages are the basics.  I have cut out a
  8. lot of material from my program (I don't want to give away _all_ my
  9. secrets <g>), and I believe you'll be able to work from this much.
  10.  
  11. const
  12.       BSize    = 4096;                                      { I/O Buffer Size }
  13.       HMax     = 512;                                   { Header Maximum Size }
  14.  
  15. type  MEDBUF       = array[1..BSize] of char;
  16. var
  17.       C            : LongInt;                                 { Buffer Offset }
  18.       FSize        : LongInt;                                     { File Size }
  19.       CH, CH1      : char;
  20.       BIN,BOUT,
  21.       BWORK        : ^MEDBUF;
  22.       F            : File;
  23.       SNAME        : String;
  24.       DATE         : string[8];                  { formatted date as YY/MM/DD }
  25.       TIME         : string[5];                  {     "     time as HH:MM    }
  26.       X1,X2,X3,X4,
  27.       X5,X6,X7,X8,
  28.       X9,X10,X11,
  29.       X12          : string;
  30.       DISKNAME     : string[15];
  31.       PRIORAN      : STR12;                              { Prior Archive Name }
  32.       DirInfo      : SearchRec;                       { File name search type }
  33.       SR           : SearchRec;
  34.       DT           : DateTime;
  35.       PATH         : PathStr;
  36.       DIR          : DirStr;
  37.       FNAME        : NameStr;
  38.       EXT          : ExtStr;
  39.       Regs         : Registers;
  40.       Temp         : String[1];
  41.       BUFF         : array[1..BSize] of Byte;
  42.  
  43. (**************************** ARJ Files Processing ***************************)
  44. Type ARJHead = record
  45.                  FHeadSize : Byte;
  46.                  ArcVer1,
  47.                  ArcVer2   : Byte;
  48.                  HostOS,
  49.                  ARJFlags,
  50.                  Method    : Byte;   { MethodType = (Stored, LZMost, LZFast); }
  51.                  R1,R2     : Byte;
  52.                  DOS_DT    : LongInt;
  53.                  CompSize,
  54.                  UCompSize,
  55.                  CRC       : LongInt;
  56.                  ENP, FM,
  57.                  HostData  : Word;
  58.                end;
  59. Var ARJ1     : ARJHead;
  60.     ARJId    : Word;                                     { 60000, if ARJ file }
  61.     HSize    : Word;                                            { Header Size }
  62. procedure GET_ARJ_ENTRY;
  63. begin
  64.   FillChar(ARJ1,SizeOf(ARJHead),#0); FillChar(BUFF,BSize,#0);
  65.   Seek (F,C-1); BlockRead(F,BUFF,BSIZE,RES);        { read header into buffer }
  66.   Move (BUFF[1],ARJId,2);  Move (BUFF[3],HSize,2);
  67.   if HSize > 0 then
  68.     with ARJ1 do
  69.       begin
  70.         Move (BUFF[5],ARJ1,SizeOf(ARJHead));
  71.         I := FHeadSize+5; SNAME := B40;
  72.         while BUFF[I] > 0 do Inc (I);
  73.         I := I-FHeadSize-5;
  74.         Move (BUFF[FHeadSize+5],SNAME[1],I); SNAME[0] := Chr(I);
  75.         FSize := CompSize; Inc (C,HSIZE);
  76.       end;
  77. end;  { GET_ARJ_ENTRY }
  78.  
  79. procedure DO_ARJ (FN : string);
  80. begin
  81.   ADD_ANAME; Assign (F,FN); Reset (F,1); C := 1;
  82.   GET_ARJ_ENTRY;                                            { Process file
  83. Header }
  84.   repeat
  85.     Inc(C,FSize+10);
  86.     GET_ARJ_ENTRY;
  87.     if HSize > 0 then
  88.       begin
  89.         Inc (WPX); New(SW[WPX]);       { store filename info in dynamic array }
  90.         with SW[WPX]^ do
  91.           begin
  92.             FSplit (SNAME,DIR,FNAME,EXT); F := FNAME; E := Copy(EXT+'    ',1,4)
  93.             SIZE := ARJ1.UCompSize;
  94.             RTYPE := 4; D_T := ARJ1.DOS_DT; ANUM := ADX; VNUM := VDX;
  95.             ADD_CNAME;
  96.           end;
  97.         Inc (CCT); SSL; Inc (ARCS[ADX]^.COUNT)
  98.       end;
  99.   until HSize <= 0;
  100.   Close (F);
  101. end;  { DO_ARJ }
  102.  
  103. ... The problem with political jokes is they get elected.
  104. --- Via Silver Xpress V3.02B12
  105. --- GOMail v1.1 [DEMO] 08-14-93
  106.  * Origin: The Private Reserve - Phoenix, AZ (602) 997-9323 (1:114/151)
  107.  
  108.